home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0026_Drawing a B-Spline curve.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  3KB  |  120 lines
  1. {
  2. SEAN PALMER
  3.  
  4. I was just toying around With a B-Spline curve routine I got out of an
  5. old issue of Byte, and thought it was pretty neat. I changed it to use
  6. fixed point fractions instead of Reals, and optimized it some...
  7.  
  8. by Sean Palmer
  9. public domain
  10. }
  11.  
  12. Var
  13.   color : Byte;
  14. Procedure plot(x, y : Word);
  15. begin
  16.   mem[$A000 : y * 320 + x] := color;
  17. end;
  18.  
  19. Type
  20.   coord = Record
  21.     x, y : Word;
  22.   end;
  23.  
  24.   CurveDataRec = Array [0..65521 div sizeof(coord)] of coord;
  25.  
  26. Function fracMul(f, f2 : Word) : Word;
  27. Inline(
  28.   $58/                   {pop ax}
  29.   $5B/                   {pop bx}
  30.   $F7/$E3/               {mul bx}
  31.   $89/$D0);              {mov ax,dx}
  32.  
  33. Function mul(f, f2 : Word) : LongInt;
  34. Inline(
  35.   $58/                   {pop ax}
  36.   $5B/                   {pop bx}
  37.   $F7/$E3);              {mul bx}
  38.  
  39.  
  40. Const
  41.   nSteps = 1 shl 8;  {about 8 For smoothness (dots), 4 For speed (lines)}
  42.  
  43. Procedure drawBSpline(Var d0 : coord; nPoints : Word);
  44. Const
  45.   nsa  = $10000 div 6;
  46.   nsb  = $20000 div 3;
  47.   step = $10000 div nSteps;
  48. Var
  49.   i, xx, yy,
  50.   t1, t2, t3,
  51.   c1, c2, c3, c4 : Word;
  52.  
  53.   d : curveDataRec Absolute d0;
  54.  
  55. begin
  56.   t1 := 0;
  57.   color := 32 + 2;
  58.  
  59.   For i := 0 to nPoints - 4 do
  60.   begin
  61.  
  62.    {algorithm converted from Steve Enns' original Basic subroutine}
  63.  
  64.     Repeat
  65.       t2 := fracMul(t1, t1);
  66.       t3 := fracMul(t2, t1);
  67.       c1 := (Integer(t2 - t1) div 2) + nsa - fracmul(nsa, t3);
  68.       c2 := (t3 shr 1) + nsb - t2;
  69.       c3 := ((t2 + t1 - t3) shr 1) + nsa;
  70.       c4 := fracmul(nsa, t3);
  71.       xx := (mul(c1, d[i].x) + mul(c2, d[i + 1].x) +
  72.              mul(c3, d[i + 2].x) + mul(c4, d[i + 3].x)) shr 16;
  73.       yy := (mul(c1, d[i].y) + mul(c2, d[i + 1].y) +
  74.              mul(c3, d[i + 2].y) + mul(c4, d[i + 3].y)) shr 16;
  75.       plot(xx, yy);
  76.       inc(t1, step);
  77.     Until t1 = 0;  {this is why nSteps must be even power of 2}
  78.    inc(color);
  79.    end;
  80. end;
  81.  
  82. Const
  83.   pts = 24; {number of points} {chose this because of colors}
  84.  
  85. Var
  86.   c : Array [-1..2 + pts] of coord;
  87.   i : Integer;
  88. begin
  89.   Asm
  90.     mov ax, $13
  91.     int $10
  92.   end;  {init vga/mcga Graphics}
  93.   randomize;
  94.   For i := 1 to pts do
  95.   With c[i] do
  96.   begin
  97.     {x:=i*(319 div pts);}    {for precision demo}
  98.     x := random(320);               {for fun demo}
  99.     y := random(200);
  100.   end;
  101.   {for i:=1 to pts div 2 do c[i*2+1].y:=c[i*2].y;}    {fit closer}
  102.   For i := 1 to pts do
  103.   With c[i] do
  104.   begin
  105.     color := i + 32;
  106.     plot(x, y);
  107.   end;
  108.   {replicate end points so curves fit to input}
  109.   c[-1] := c[1];
  110.   c[0]  := c[1];
  111.   c[pts + 1] := c[pts];
  112.   c[pts + 2] := c[pts];
  113.   drawBSpline(c[-1], pts + 4);
  114.   readln;
  115.   Asm
  116.     mov ax, 3
  117.     int $10
  118.   end;  {Text mode again}
  119. end.
  120.